﻿Imports System.Drawing.Imaging
Imports System.Math
    Public Structure pot
        Dim coorx As Double
        Dim coory As Double
    End Structure
Module Moraverc
    Public Picture1 As Image
    Public Picture1bit As Bitmap
    Public Picture1gray As Bitmap
    Public Picture2 As Bitmap
    Public resultImg As Bitmap
    Public resultImg2 As Bitmap
    Public isLoadPic As Boolean

    '导入图片过程
    Sub input()
        Dim OFD As New OpenFileDialog
        OFD.Filter = "图像文件 (*.bmp;*.gif;*.jpg;*.jpeg;*.png)|*.bmp;*.gif;*.jpg;*.jpeg;*.png"
        OFD.FilterIndex = 0
        If OFD.ShowDialog = DialogResult.OK Then
            Picture1 = Image.FromFile(OFD.FileName)
            Form1.PictureBox2.Image = Nothing
        Else
            MsgBox("未选择文件", 64, "警告")
            Exit Sub
        End If
        isLoadPic = True
    End Sub
    '点提取
    ' Moravec算子
    Public Sub Moravec(ByVal picture1 As Image)
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim pSourceColor As Color
        Dim pDestColor As Color
        Dim R, G, B As Integer
        Dim gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)

        Dim window(4, 4) As Double
        Dim K As Integer = Int（window.GetLength(0) / 2）
        Dim x, y As Integer
        Dim IV(matrix.GetLength(0) - 1, matrix.GetLength(1) - 1) As Double
        Dim limit As Double = 20
        Dim Picture1bit As Bitmap
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg

        For i As Integer = 0 To matrix.GetLength(0) - (window.GetLength(0) - 1) - 1
            For j As Integer = 0 To matrix.GetLength(1) - (window.GetLength(0) - 1) - 1
                Dim area(,) As Integer = slice({i, j}, window.GetLength(0), Picture1gray)
                x = i + K
                y = j + K
                Dim V(3) As Double
                For m As Integer = -K To K - 1
                    V(0) += (area(K + m, K) - area(K + m + 1, K)) ^ 2
                    V(1) += (area(K + m, K + m) - area(K + m + 1, K + m + 1)) ^ 2
                    V(2) += (area(K, K + m) - area(K, K + m + 1)) ^ 2
                    V(3) += (area(K + m, K - m) - area(K + m + 1, K - m - 1)) ^ 2
                Next
                If V.Min > limit Then
                    resultImg.SetPixel(x, y, Color.FromArgb(V.Min \ 400, V.Min \ 400, V.Min \ 400))
                End If
            Next
        Next

        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        For i As Integer = 0 To matrix.GetLength(0) - (window.GetLength(0) - 1) - 1
            For j As Integer = 0 To matrix.GetLength(1) - (window.GetLength(0) - 1) - 1
                Dim area(,) As Integer = slice({i, j}, window.GetLength(0), resultImg)
                Dim max As Integer = 0
                Dim wi As Integer = 0
                Dim hi As Integer = 0
                For w As Integer = 0 To window.GetLength(0) - 1
                    For h As Integer = 0 To window.GetLength(1) - 1
                        If area(w, h) > max Then
                            max = area(w, h)
                            wi = w
                            hi = h
                        End If
                    Next
                Next
                If max = 0 Then
                    Continue For
                End If
                resultImg2.SetPixel(i + wi, j + hi, Color.FromArgb(0, 0, 0))
            Next
        Next

    End Sub

    ' 线提取一阶算子
    '一阶差分梯度算子
    Public Sub FirOrderDifferGrad(ByVal picture1 As Image)
        '准备及灰度化
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim Picture1bit As Bitmap
        Dim pSourceColor, pDestColor As Color
        Dim R, G, B, gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)
        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg
        '正式计算
        For i As Integer = 0 To picture1.Width - 2
            For j As Integer = 0 To picture1.Height - 2
                Dim ji, ji_right, ji_down, single_value As Integer
                ji = Round(matrix(i, j))
                ji_right = Round(matrix(i + 1, j))
                ji_down = Round(matrix(i, j + 1))
                single_value = Abs(ji - ji_right) + Abs(ji - ji_down)
                If single_value > 255 Then
                    matrix(i, j) = 255
                Else
                    If single_value < 0 Then
                        matrix(i, j) = 0
                    Else
                        matrix(i, j) = single_value
                    End If
                End If
                resultImg2.SetPixel(i, j, Color.FromArgb(matrix(i, j), matrix(i, j), matrix(i, j)))
            Next
        Next
    End Sub
    '一阶差分Robert's梯度算子
    Public Sub Roberts(ByVal picture1 As Image)
        '准备及灰度化
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim Picture1bit As Bitmap
        Dim pSourceColor, pDestColor As Color
        Dim R, G, B, gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)
        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg
        '正式计算
        For i As Integer = 0 To picture1.Width - 2
            For j As Integer = 0 To picture1.Height - 2
                Dim single_value As Integer
                single_value = Abs(matrix(i + 1, j + 1) - matrix(i, j)) + Abs(matrix(i, j + 1) - matrix(i + 1, j))
                If single_value > 255 Then
                    matrix(i, j) = 255
                Else
                    If single_value < 0 Then
                        matrix(i, j) = 0
                    Else
                        matrix(i, j) = single_value
                    End If
                End If
                resultImg2.SetPixel(i, j, Color.FromArgb(matrix(i, j), matrix(i, j), matrix(i, j)))
            Next
        Next
    End Sub
    '一阶方向差分算子（以北方向为例）
    Public Sub FirOrderDifferDirection(ByVal picture1 As Image)
        '准备及灰度化
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim Picture1bit As Bitmap
        Dim pSourceColor, pDestColor As Color
        Dim R, G, B, gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)
        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg
        '正式计算
        For i As Integer = 1 To picture1.Width - 2
            For j As Integer = 1 To picture1.Height - 2
                Dim single_value As Integer
                '北方向
                single_value = Round(Abs(matrix(i - 1, j - 1) + matrix(i, j - 1) + matrix(i + 1, j - 1) + matrix(i - 1, j) - 2 * matrix(i, j) + matrix(i + 1, j) - matrix(i - 1, j + 1) - matrix(i, j + 1) - matrix(i + 1, j + 1)))
                If single_value > 255 Then
                    matrix(i, j) = 255
                Else
                    If single_value < 0 Then
                        matrix(i, j) = 0
                    Else
                        matrix(i, j) = single_value
                    End If
                End If
                resultImg2.SetPixel(i, j, Color.FromArgb(matrix(i, j), matrix(i, j), matrix(i, j)))
            Next
        Next
    End Sub
    '一阶差分Prewitt算子
    Public Sub Prewitt(ByVal picture1 As Image)
        '准备及灰度化
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim Picture1bit As Bitmap
        Dim pSourceColor, pDestColor As Color
        Dim R, G, B, gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)
        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg
        '正式计算
        For i As Integer = 1 To picture1.Width - 2
            For j As Integer = 1 To picture1.Height - 2
                Dim Gx, Gy, single_value As Integer
                Gx = Abs(matrix(i - 1, j - 1) - matrix(i + 1, j - 1) + matrix(i - 1, j) - matrix(i + 1, j) + matrix(i - 1, j + 1) - matrix(i + 1, j + 1))
                Gy = Abs(matrix(i - 1, j + 1) + matrix(i, j + 1) + matrix(i + 1, j + 1) - matrix(i - 1, j - 1) - matrix(i, j - 1) - matrix(i + 1, j - 1))
                single_value = Sqrt(Gx ^ 2 + Gy ^ 2)
                If single_value > 255 Then
                    matrix(i, j) = 255
                Else
                    If single_value < 12 Then
                        matrix(i, j) = 0
                    Else
                        matrix(i, j) = single_value
                    End If
                End If
                resultImg2.SetPixel(i, j, Color.FromArgb(matrix(i, j), matrix(i, j), matrix(i, j)))
            Next
        Next
    End Sub
    '一阶差分Sober算子
    Public Sub Sober(ByVal picture1 As Image)
        '准备及灰度化
        Dim destImg As New Bitmap(picture1.Width, picture1.Height)
        Dim Picture1bit As Bitmap
        Dim pSourceColor, pDestColor As Color
        Dim R, G, B, gray As Integer
        Dim matrix(picture1.Width - 1, picture1.Height - 1) As Double
        resultImg = New Bitmap(picture1.Width, picture1.Height)
        resultImg2 = New Bitmap(resultImg.Width, resultImg.Height)
        Picture1bit = picture1.Clone
        For i As Integer = 0 To picture1.Width - 1
            For j As Integer = 0 To picture1.Height - 1
                pSourceColor = Picture1bit.GetPixel(i, j)
                R = pSourceColor.R
                G = pSourceColor.G
                B = pSourceColor.B
                gray = R * 0.3 + G * 0.59 + B * 0.11
                pDestColor = Color.FromArgb(gray, gray, gray)
                matrix(i, j) = gray
                destImg.SetPixel(i, j, pDestColor)
            Next
        Next
        Picture1gray = destImg
        '正式计算
        For i As Integer = 1 To picture1.Width - 2
            For j As Integer = 1 To picture1.Height - 2
                Dim Gx, Gy, single_value As Integer
                Gx = Abs(matrix(i - 1, j - 1) - matrix(i + 1, j - 1) + 2 * matrix(i - 1, j) - 2 * matrix(i + 1, j) + matrix(i - 1, j + 1) - matrix(i + 1, j + 1))
                Gy = Abs(matrix(i - 1, j + 1) + 2 * matrix(i, j + 1) + matrix(i + 1, j + 1) - matrix(i - 1, j - 1) - 2 * matrix(i, j - 1) - matrix(i + 1, j - 1))
                single_value = Round(Sqrt(Gx ^ 2 + Gy ^ 2))
                If single_value > 255 Then
                    matrix(i, j) = 255
                Else
                    If single_value < 0 Then
                        matrix(i, j) = 0
                    Else
                        matrix(i, j) = single_value
                    End If
                End If
                resultImg2.SetPixel(i, j, Color.FromArgb(matrix(i, j), matrix(i, j), matrix(i, j)))
            Next
        Next
    End Sub
    '保存图片
    Sub SaveJPG(ByVal outpicture As Image)
        Dim SFD As New SaveFileDialog
        SFD.Filter = "JPG格式|*.jpg"
        SFD.FilterIndex = 0
        If SFD.ShowDialog = DialogResult.OK Then
            outpicture.Save(SFD.FileName, Imaging.ImageFormat.Jpeg)
            MsgBox("保存完成", 64, "提示")
        End If
    End Sub
    '切片
    Public Function slice(start As Integer(), windowSize As Integer, img As Bitmap)
        Dim array(windowSize - 1, windowSize - 1) As Integer
        For i As Integer = 0 To windowSize - 1
            For j As Integer = 0 To windowSize - 1
                array(i, j) = img.GetPixel(start(0) + i, start(1) + j).R
            Next
        Next
        Return array
    End Function

End Module
